home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / MacBinary II+ 1.0.0 / source / Displays.p < prev    next >
Encoding:
Text File  |  1992-11-23  |  1.1 KB  |  71 lines  |  [TEXT/PJMM]
  1. unit Displays;
  2.  
  3. interface
  4.  
  5.     var
  6.         display_done, display_total: longInt;
  7.  
  8.     procedure InitDisplay;
  9.     procedure FinishDisplay;
  10.     procedure UpdateDisplay;
  11.  
  12. implementation
  13.  
  14.     uses
  15.         FixMath;
  16.  
  17.     var
  18.         dlg: dialogPtr;
  19.         has_colorqd: boolean;
  20.  
  21.     procedure InitDisplay;
  22.         var
  23.             sysenv: sysEnvRec;
  24.             oe: OSErr;
  25.     begin
  26.         display_done := 0;
  27.         display_total := 0;
  28.         dlg := GetNewDialog(129, nil, POINTER(-1));
  29.         oe := SysEnvirons(1, sysEnv);
  30.         has_colorqd := sysenv.hasColorQD;
  31.     end;
  32.  
  33.     procedure FinishDisplay;
  34.     begin
  35.         DisposeDialog(dlg);
  36.     end;
  37.  
  38.     procedure UpdateDisplay;
  39.         const
  40.             HiliteRGBP = $DA0;
  41.         type
  42.             RGBColorPtr = ^RGBColor;
  43.         var
  44.             box: rect;
  45.             w, uw: integer;
  46.             oldfore: RGBColor;
  47.     begin
  48.         SetPort(dlg);
  49.         box := dlg^.portRect;
  50.         with box do begin
  51.             w := right - left;
  52.             if display_total = 0 then
  53.                 uw := 0
  54.             else
  55.                 uw := FracMul(w, FracDiv(display_done, display_total));
  56.             right := left + uw;
  57.             if has_colorQD then begin
  58.                 GetForeColor(oldfore);
  59.                 RGBForeColor(RGBColorPtr(HiliteRGBP)^);
  60.                 PaintRect(box);
  61.                 RGBForeColor(oldfore);
  62.             end
  63.             else
  64.                 FillRect(box, gray);
  65.             left := right;
  66.             right := right + w - uw;
  67.             EraseRect(box);
  68.         end;
  69.     end;
  70.  
  71. end.